home *** CD-ROM | disk | FTP | other *** search
/ Light ROM 1 / LIGHT-ROM 1 (Amiga Library Services)(1994).iso / ffdisks / d880.lha / Oberon / O3Demo2.lzh / Examples / ConcurrencyDemo.mod < prev    next >
Text File  |  1993-01-15  |  2KB  |  108 lines
  1. MODULE ConcurrencyDemo;
  2.  
  3. IMPORT C := Concurrency,
  4.        B := BasicTypes,
  5.        E := Exec,
  6.        I := Intuition,
  7.        D := Display;
  8.  
  9. VAR p: C.Process;
  10.  
  11. TYPE
  12.   Window = POINTER TO WindowDesc;
  13.   WindowDesc = RECORD (B.ANYDesc)
  14.     x,y,w,h: INTEGER;
  15.   END;
  16.  
  17. VAR w: Window;
  18.  
  19.  
  20. PROCEDURE New(w: B.ANY): B.ANY;
  21.  
  22. VAR
  23.   win: D.WindowPtr;
  24.   i,top: INTEGER;
  25.   msg: E.MessagePtr;
  26.   fertig: BOOLEAN;
  27.  
  28.   PROCEDURE NewProcess;
  29.   VAR
  30.     new: Window;
  31.   BEGIN
  32.     NEW(new);
  33.     new.x := win.window.leftEdge + 20; new.w := win.window.width;
  34.     new.y := win.window.topEdge  + 20; new.h := win.window.height;
  35.     IF C.NewProcess(New,new)=NIL THEN END;
  36.   END NewProcess;
  37.  
  38. BEGIN
  39.  
  40.   WITH w: Window DO
  41.  
  42.     NEW(win);
  43.     IF D.OpenWindow(win,"Neuer Prozeß",w.x,w.y,w.w,w.h,NIL) THEN
  44.  
  45.       I.OldModifyIDCMP(win.window,LONGSET{I.closeWindow,I.newSize,I.vanillaKey});
  46.  
  47.       top := win.rp.font.ySize;
  48.       fertig := FALSE;
  49.  
  50.       REPEAT
  51.         D.FrontPen(win,1);
  52.         D.Jam1(win);
  53.         D.Home(win);
  54.         D.Write(win,"Taste <S> startet noch einen Prozeß!");
  55.         D.Complement(win);
  56.         msg := NIL;
  57.         WHILE msg=NIL DO
  58.           i := 0;
  59.           WHILE (i<=win.width-2) & (msg=NIL) DO
  60.             D.Line(win,0,top,win.width-1-i,win.height-1);
  61.             D.Line(win,win.width-1-i,top,win.width-1,win.height-1);
  62.             msg := E.GetMsg(win.window.userPort);
  63.             INC(i,2);
  64.           END;
  65.         END;
  66.  
  67.         IF msg#NIL THEN
  68.           WITH msg: I.IntuiMessage DO
  69.             IF    I.newSize     IN msg.class THEN
  70.               D.Init(win); D.Clear(win);
  71.             ELSIF I.vanillaKey  IN msg.class THEN
  72.               IF CAP(CHR(msg.code))="S" THEN NewProcess END;
  73.             ELSIF I.closeWindow IN msg.class THEN
  74.               fertig := TRUE;
  75.             END;
  76.             E.ReplyMsg(msg);
  77.           END;
  78.         END;
  79.  
  80.       UNTIL fertig;
  81.  
  82.       D.Close(win);
  83.  
  84.     END;   (* IF D.OpenWindow(..) END; *)
  85.  
  86.   END;   (* WITH w: Window DO *)
  87.  
  88.   RETURN NIL;
  89.  
  90. END New;
  91.  
  92.  
  93. BEGIN
  94.  
  95.   NEW(w);
  96.   w.x := 0;
  97.   w.y := 0;
  98.   w.w := 320;
  99.   w.h := 70;
  100.   p := C.NewProcess(New,w);
  101.  
  102. CLOSE
  103.  
  104.   C.WaitForAllProcesses;
  105.  
  106. END ConcurrencyDemo.
  107.  
  108.